Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/printing/virtua/virtual.frm

Text File | 1994-10-17 | 16KB | 560 lines

VERSION 2.00
Begin Form virtual
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Virtual Printing Demo"
   ClientHeight    =   5565
   ClientLeft      =   1635
   ClientTop       =   1545
   ClientWidth     =   9450
   Height          =   6000
   Left            =   1560
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5565
   ScaleWidth      =   9450
   Top             =   1185
   Width           =   9600
   Begin PictureBox Picture2
      Align           =   1  'Align Top
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   0  'None
      Height          =   495
      Left            =   0
      ScaleHeight     =   495
      ScaleWidth      =   9450
      TabIndex        =   0
      Top             =   0
      Width           =   9450
      Begin CommonDialog CMDialog1
         CancelError     =   -1  'True
         DefaultExt      =   "*.mdb"
         DialogTitle     =   "Location of crystal.mdb"
         Filename        =   "*.mdb"
         Filter          =   "*.mdb"
         Left            =   0
         Top             =   0
      End
      Begin PictureBox btnMove
         BorderStyle     =   0  'None
         Height          =   330
         Index           =   3
         Left            =   7155
         Picture         =   VIRTUAL.FRX:0000
         ScaleHeight     =   330
         ScaleWidth      =   360
         TabIndex        =   10
         Tag             =   "Last Page"
         Top             =   90
         Width           =   360
      End
      Begin PictureBox btnMove
         BorderStyle     =   0  'None
         Height          =   330
         Index           =   0
         Left            =   6120
         Picture         =   VIRTUAL.FRX:0182
         ScaleHeight     =   330
         ScaleWidth      =   360
         TabIndex        =   9
         Tag             =   "First Page"
         Top             =   90
         Width           =   360
      End
      Begin PictureBox btnMove
         BorderStyle     =   0  'None
         Height          =   330
         Index           =   2
         Left            =   6810
         Picture         =   VIRTUAL.FRX:0304
         ScaleHeight     =   330
         ScaleWidth      =   360
         TabIndex        =   8
         Tag             =   "Next Page"
         Top             =   90
         Width           =   360
      End
      Begin PictureBox btnMove
         BorderStyle     =   0  'None
         Height          =   330
         Index           =   1
         Left            =   6465
         Picture         =   VIRTUAL.FRX:0486
         ScaleHeight     =   330
         ScaleWidth      =   360
         TabIndex        =   7
         Tag             =   "Previous Page"
         Top             =   90
         Width           =   360
      End
      Begin SSPanel lbPage
         BevelInner      =   1  'Inset
         BevelOuter      =   0  'None
         Caption         =   "Page 99 of 99"
         ForeColor       =   &H00000000&
         Height          =   375
         Left            =   7680
         TabIndex        =   6
         Top             =   60
         Width           =   1695
      End
      Begin ComboBox cmbZoom
         Height          =   300
         Left            =   4800
         Style           =   2  'Dropdown List
         TabIndex        =   4
         Top             =   105
         Width           =   975
      End
      Begin PictureBox Picture1
         BackColor       =   &H00C0C0C0&
         BorderStyle     =   0  'None
         Height          =   255
         Left            =   6000
         ScaleHeight     =   255
         ScaleWidth      =   255
         TabIndex        =   3
         Top             =   0
         Width           =   255
      End
      Begin CommandButton btnClose
         Cancel          =   -1  'True
         Caption         =   "&Close"
         Height          =   405
         Left            =   1485
         TabIndex        =   2
         TabStop         =   0   'False
         Top             =   45
         Width           =   1300
      End
      Begin CommandButton btnPrint
         Caption         =   "&Print"
         Height          =   405
         Left            =   180
         TabIndex        =   1
         TabStop         =   0   'False
         Top             =   45
         Width           =   1300
      End
      Begin Label Label1
         AutoSize        =   -1  'True
         BackColor       =   &H00C0C0C0&
         Caption         =   "&Zoom:"
         Height          =   195
         Index           =   0
         Left            =   4200
         TabIndex        =   5
         Top             =   150
         Width           =   540
      End
   End
   Begin vsViewPort vPort
      BackColor       =   &H00808080&
      Height          =   5655
      Left            =   0
      Top             =   490
      VirtualHeight   =   0
      VirtualWidth    =   0
      Width           =   9610
      Begin vsPrinter vPrint
         AbortCaption    =   ""
         BorderStyle     =   0  'None
         BrushStyle      =   1  'Transparent
         FontName        =   "Arial"
         FontSize        =   10
         HdrFontName     =   "Arial"
         HdrFontSize     =   10
         Height          =   5500
         Left            =   0
         TableBorder     =   0  'None
         TableSep        =   "|;"
         Top             =   0
         Width           =   9460
      End
   End
End
'=======================================================================
'
'  Virtual vsView.vbx demo
'
'  demonstrated virtual memory programming of the vsView
'  print preview vbx
'
'  overcomes the speed and memory barriers of the
'  vsView.vbx
'
'  but, unfortunately, demonstrates the header problem
'
'  written by Brian C. Hayes
'             CIS 74653,1760
'             October 18, 1994
'
'  If you feel it has any merit, use and distribute freely.
'
'  Comments and criticism welcome.
'
'=======================================================================

Dim fmt$                'column width and alignment string
Dim TableHeader$        'Column Headings
Dim HeaderStr$          'page header
Dim FooterStr$          'page footer
Dim numFields%          'number of columns in report
Dim curRow%             'current line (record) to print
Dim CurPage%            'currently displayed page
Dim LastPage%           'last page number of the document
Dim NextPage%           'flag if a next page exists
Dim EndOfPage%          'flag when page ends
Dim PageRow%(1 To 100)  'first bookmark (row) on each page
Dim dbName$

Sub btnClose_Click ()
    virtual.Visible = False
    End
End Sub

Sub btnMove_Click (Index As Integer)
    Select Case Index
       Case 0
          CurPage = 1
       Case 1
          CurPage = CurPage - 1
       Case 2
          CurPage = CurPage + 1
       Case 3
          CurPage = LastPage
    End Select
    Screen.MousePointer = HOURGLASS
    TablePreview
    Screen.MousePointer = Default
End Sub

Sub btnPrint_Click ()
    Picture2.SetFocus   'don't highlight the button
    Screen.MousePointer = HOURGLASS
    vPrint.Preview = False
    TablePreview
    vPrint.Preview = True
    Screen.MousePointer = Default
End Sub

Sub CheckMoveBtns ()
    If NextPage Then
       'not on last page yet
       PageRow(CurPage + 1) = curRow
       btnMove(2).Picture = ArtForm.Image1(5).Picture
       btnMove(2).Enabled = True
    Else
       'last page of document
       LastPage = CurPage
       btnMove(2).Picture = ArtForm.Image1(4).Picture
       btnMove(2).Enabled = False
    End If

    If CurPage < 2 Then
       btnMove(1).Picture = ArtForm.Image1(6).Picture
       btnMove(1).Enabled = False
       btnMove(0).Picture = ArtForm.Image1(0).Picture
       btnMove(0).Enabled = False
    Else
       btnMove(1).Picture = ArtForm.Image1(7).Picture
       btnMove(1).Enabled = True
       btnMove(0).Picture = ArtForm.Image1(1).Picture
       btnMove(0).Enabled = True
    End If

    If LastPage <> 0 Then
       If CurPage < LastPage Then
          btnMove(3).Picture = ArtForm.Image1(3).Picture
          btnMove(3).Enabled = True
       Else
          btnMove(3).Picture = ArtForm.Image1(2).Picture
          btnMove(3).Enabled = False
       End If
    Else
       btnMove(3).Picture = ArtForm.Image1(2).Picture
       btnMove(3).Enabled = False
    End If
End Sub

Sub cmbZoom_Click ()
    vPrint.Visible = False

    'resize the page
    vPrint.Width = vPrint.PageWidth * Val(cmbZoom) / 100
    vPrint.Height = vPrint.PageHeight * Val(cmbZoom) / 100
    vPort.VirtualWidth = vPrint.Width + 400
    vPort.VirtualHeight = vPrint.Height + 400

    'center picture if its small
    If vPrint.Width < vPort.Width Then
       vPrint.Left = (vPort.Width - vPrint.Width) / 2
    End If
    If vPrint.Height < vPort.Height Then
       vPrint.Top = (vPort.Height - vPrint.Height) / 2
    End If
    If Val(cmbZoom) > 99 Then
       vPrint.Top = 0
       vPrint.Left = 0
    End If
    vPrint.Visible = True
End Sub

Sub DeriveHeader ()

    '==================================================================
    'Because virtual printing is used, cannot use the usual "Page d%"
    'method of printing page number in headers/footers.  Therefore,
    'derive header must be called for each page.
    '
    '   (In my complete application, the user has complete control
    '    over the headers and footers through an Options function,
    '    thus, DeriveHeader is much more complicated than this demo)
    '==================================================================

    HeaderStr = Format$(Now, "dd-mmm-yyyy") & "|" & "|" & "Page " & Trim$(Str$(CurPage))
    FooterStr = "FooterLeft" & "|" & "vsView Virtual Printing Demo" & "|" & "FooterRight"
    vPrint.Header = HeaderStr
    vPrint.Footer = FooterStr
End Sub

Function EstNumPages% (RowsPerPage%)

    '==================================================================
    'Returns an estimate of the number of pages based on the number of
    'records in dynaset and the number of rows printed on the first page.
    '
    'Because the document is constructed one page at a time, the total
    'number of pages in the document is not known until the user has
    'paged to the last page.
    '
    'Therefore, EstNumPages is used in the Page Indicator section of the
    'toolbar until the actual number of pages is known.  Once the last
    'page is actually known, the Page Indicator refers to the actual
    'last page number, stored in the form-level integer 'LastPage'.
    '==================================================================

    Dim x%

    If RowsPerPage Then
       x = gDS.RecordCount / (RowsPerPage + 2)
       If x > Int(x) / x Then
          EstNumPages = Int(x) + 1
       Else
          EstNumPages = Int(x)
       End If
    Else
       EstNumPages = 1
    End If
End Function

Sub FindDBFile ()
    On Error Resume Next
    CMDialog1.Action = 1
    If Err = 32755 Then End
    dbName = CMDialog1.Filename
    If Right$(UCase$(dbName), 11) <> UCase$("crystal.mdb") Then
       End
    End If
    dbName = CMDialog1.Filename
End Sub

Sub Form_Load ()
    virtual.WindowState = MAXIMIZED
    vPort.Height = 6420
    vPort.Width = 9610
    vPrint.Height = 6420
    vPrint.Width = 9610

    cmbZoom.AddItem "35%"
    cmbZoom.AddItem "50%"
    cmbZoom.AddItem "75%"
    cmbZoom.AddItem "100%"
    cmbZoom.AddItem "150%"
    cmbZoom.AddItem "200%"

    btnPrint.Enabled = False

    'find crystal.mdb
    FindDBFile

    API_ResetStopWatch
    GetResultSet
    qTime = API_StopWatch()

    API_ResetStopWatch
    vPrint.Preview = True

    InitTable

    'display the first page
    TablePreview

    'display timing window
    ptime = API_StopWatch()
    timing.Show MODAL
End Sub

Function GetNextLine (row%) As String

    '==================================================================
    'Returns the next record from the result set as formatted text.
    'Called from the TablePreview procedure after each line is printed.
    '
    'The format (column width and alignment) was initialy derived in
    'the TableInit procedure and stored in the form-level string
    'variable 'fmt'.
    '
    '==================================================================

    Dim t$, separator$
    Dim i%

    'return if no more data in result set
    If row > gDS.RecordCount - 1 Then
       NextPage = False
       vPrint.Action = 6
       GetNextLine = ""
       Exit Function
    End If

    'point to appropriate row in the result set
    gDS.Bookmark = gBookmarks(row)
    For i = 0 To numFields
       If i < numFields Then
          separator = "|"
       Else
          separator = ";"
       End If
       t = t & Str$(gDS(i)) & separator
    Next
    GetNextLine = fmt & t
End Function

Function GetPageIndicator$ ()

    Dim page$
    page = "Page " & Trim$(Str$(CurPage)) & " of "
    If LastPage Then
       page = page & Trim$(Str$(LastPage))
    Else
       page = page & Trim$(Str$(EstNumPages(PageRow(2))))
    End If
    GetPageIndicator = page
End Function

Sub GetResultSet ()
    Dim SQLQ$
    Dim c%

    SQLQ = "Select OrderNum,ItemNum,Qty,Price FROM Detail ORDER BY OrderNum"
    Set gDB = OpenDatabase(dbName)
    Set gDS = gDB.CreateDynaset(SQLQ)

    'store bookmarks in array
    gDS.MoveLast
    ReDim gBookmarks$(gDS.RecordCount)
    gDS.MoveFirst
    While Not gDS.EOF
       c = c + 1
       gBookmarks(c - 1) = gDS.Bookmark
       gDS.MoveNext
    Wend

End Sub

Sub InitTable ()
    'Initialize Table Information
    numFields = 3
    fmt = "1500|^1500|>1000|>1500;"
    TableHeader = "Order Number|Item Number|Quantity|Price;"

    'format header and footer characteristics
    vPrint.HdrFontName = "Arial"
    vPrint.HdrFontSize = 10
    vPrint.HdrFontBold = False
    vPrint.HdrFontItalic = False

    cmbZoom.ListIndex = 3
    CurPage = 1
    PageRow(1) = 0
End Sub

Sub PrintTableHeader ()

    '==================================================================
    'Prints the TableHeader (column labels) at the start of each page.
    '==================================================================

    vPrint.TextAlign = 1
    vPrint = ""
    vPrint.FontBold = True
    vPrint.Table = fmt & TableHeader
    vPrint.FontBold = False
End Sub

Sub PrintTitle ()
    vPrint = ""
    vPrint.FontName = "Arial"
    vPrint.FontSize = 14
    vPrint.FontBold = True
    vPrint.FontItalic = True
    vPrint.FontUnderline = False
    vPrint = "Sample Data Results"
End Sub

Sub TablePreview ()

    Dim pageIndicator$
    Dim x%
    Dim t$

    Screen.MousePointer = HOURGLASS

    DeriveHeader

    vPrint.Action = 3       'Start Document
    vPrint.TextAlign = 1    'center alignment

    If CurPage = 1 Then
       PrintTitle
    End If

    'Set table formatting information
    vPrint.PenWidth = 2
    vPrint.FontSize = 10
    vPrint.FontItalic = False
    vPrint.FontUnderline = False
    vPrint.FontName = "Times New Roman"

    'print the table
    curRow = PageRow(CurPage)
    EndOfPage = False
    NextPage = False
    PrintTableHeader
    While Not EndOfPage
       t = GetNextLine(curRow)
       If t <> "" Then
          vPrint.Table = t
          curRow = curRow + 1
       Else
          NextPage = False
          EndOfPage = True
       End If
    Wend
    CheckMoveBtns
    vPrint.Action = 6   'end doc

    'print the page indicator in the toolbar
    lbPage.Caption = GetPageIndicator()

    Screen.MousePointer = Default
End Sub

Sub vPrint_EndPage ()
    EndOfPage = True
    NextPage = True
End Sub